perm filename FILXGP.FAI[NEW,LCS]7 blob
sn#525368 filedate 1980-07-25 generic text, type T, neo UTF8
TITLE FILLMS
ENTRY FILLMS,LL
EXTERNAL DL,PLTR,STF,ALF,LINED,UNPACK,INCR,DST
RINP: BLOCK =900
;DST: 0.004 ;BB CHANGE DIST2,3,4 TO JFCL FOR DISTORTION.
; 3.6 ;CC ALSO CHANGE DIST1(LINXGP) TO JFCL
LL: 0
;****** CHANGE 3, 4 AND 5 TO JFCL IN DDT WHEN USING DISTORTION.(SEE 'LINES')
; SUBROUTINE FILLMS(L,IDAT,R2,CENTR,R6,R7)
; COMMON/DL/RSIZ,SAVER,NAME
; COMMON/DST/BB,CC/FLM/X(600)
; DIMENSION IDAT(1),NX(600)
; EQUIVALENCE (NX,X)
; COMMON/PLTR/IPLT,RHT,DIS/LL/LL/STF/RR(8),RSTJ2
; MD=DISPLAY MP=PLOTTER MX=XGP
; DATA M2/2/
FILLMS: 0
MOVE PLTR+2 ;
MOVEM DX# ; DX=DIS
MOVE PLTR+1 ; RX=RHT
MOVEM RX#
MOVE @4(16) ; D=RSTJ2*R6
FMPR STF+10
MOVEM D#
MOVE @5(16) ; R=RSTJ2*R7
FMPR STF+10
MOVEM R#
DIST2: JRST FM1 ;GO TO 1
MOVE DST+1
MOVEM C# ; C=CC
MOVE DST ; B=BB
MOVEM B# ; SAVES IT. IT WILL RETURN LATER.
FDVR PLTR+2 ; BB=B/DIS
MOVEM DST
MOVE [1000.0] ; CC=1000
MOVEM DST+1
FM1: MOVNI 13,2 ;1 KK=-2
SETZ 7, ; KK IS 13, J IS 7 DO 205 J=1,L
MOVEI 12,@1(16) ;LOC OF IDAT
FM205: ADDI 13,3 ; KK=KK+3
; KX=KK+2
JSA 16,UNPACK ; CALL UNPACK(M,N,IDAT(J))
4 ;X COORD.
5 ;Y COORD.
(12) ; ; 12 IS IDAT ARRAY
AOJ 12, ; UPDATE POINTER
MOVEM 1,RINP+1(13) ; LL (=2 PEN DN., =3 PEN UP.)
FLTR 4 ; X(KK)=(R2+D*M)*DIS
FMPR D ;CC X(KK)=ROFF((R2+D*M)*DIS)
FADR @2(16)
FMPR PLTR+2
MOVEM RINP-1(13) ; X COORD.
FLTR 5 ;CC X(KK+1)=ROFF((CENTR+R*N)*RHT)
FMPR R ; X(KK+1)=(CENTR+R*N)*RHT
FADR @3(16)
FMPR PLTR+1
MOVEM RINP(13) ; Y COORD.
DIST3: JRST FM3 ;3 GO TO 205
MOVM RINP-1(13)
FMPR DST ; X(KK+1)=X(KK+1)*(C-BB*(ABS(X(KK))))
MOVNS ;C FOR DISTORTION
FADR C
FMPRM RINP(13)
FM3: AOJ 7, ;205 CONTINUE
CAME 7,@(16)
JRST FM205
ADDI 13,2 ; NX(3)=KX
MOVEM 13,RINP+2
MOVSI 201400
MOVEM PLTR+2 ; DIS=1.0
MOVEM PLTR+1 ; RHT=DIS
;; MOVEI 10,1 ; IF(IPLT)M=RSIZ+.4
;*** MOVE [1.7] ; IF(M.LE.0)M=1
;*** JUL 79 CAMG DL ; IF(M.GT.M2)M=M2
MOVE INCR
CAIGE =10 ;INCR ≥10 MEANS CALCMP STYLE FILLER
JRST VRN ; (OLD FILLER. SAVES PEN TIME.)
IDIVI 0,=10 ;INCR=INCR/10 INCR=20 GIVES INCREMENT OF 2
MOVEM INC#
JRST CALCMP
VRN: FLTR 0,0 ; RINCR=INCR
MOVEM RINCR#
; SUBROUTINE FILLER(QQ,MD)
; COMMON /RINP/I(1) /ALF/NO,H(72) /PLTR/P,RHT,DIS
; DIMENSION Q(1)
; H(72) =NO MORE THAN 72 SEGS AT ANY SLICE POSITION!!!
;FILLER: 0 ; EQUIVALENCE (Q,I),(KNT,I(3))
MOVE RINP ; RL=Q(1)
MOVEM LEFT# ; FLOATING!
MOVEM RIGHT# ; RR=RL
SETZ 2, ; DO 1 K=1,KNT,3
FL1: MOVE RINP+2(2) ;CC Q(K)=IFIX(Q(K))
CAIN 3 ;CC Q(K+1)=IFIX(Q(K+1))
SETOM RINP+2(2) ;DO THIS ABOVE? IF(I(K+2).EQ.3)I(K+2)=-1
MOVE RINP(2) ; A=Q(K)
CAMN RINP+3(2) ; IF(Q(K+3).EQ.A)I(K+5)=-1
SETOM RINP+5(2) ;C VERTICAL LINES WILL BE IGNORED.
CAMGE LEFT ; IF(RL.GT.A)RL=A
MOVEM LEFT
CAMLE RIGHT ;1 IF(RR.LT.A)RR=A
MOVEM RIGHT ;C GET LEFT AND RIGHT EXTREME LIMITS.
ADDI 2,3 ;K=K+3
CAMGE 2,RINP+2 ;I(3)
JRST FL1
MOVN [0.5] ; RR=RR-.5
;; FADRM RIGHT
FADRM LEFT ; RL=RL-.5
;;;;FL2: MOVSI 201400 ;2 RL=RL+1
FL2: MOVE RINCR ;2 RL=RL+RINCR
FADRB LEFT ;C SLICE COUNTER
CAML RIGHT ; IF(RL.GT.RR)RETURN
JRST FM6 ;JRA 16,2(16)
SETZ 11, ; M=0
MOVEI 2,3 ; DO 3 J=4,KNT,3
FL3: SKIPGE RINP+2(2) ; IF(I(J+2))GO TO 3
JRST FLX3
MOVE RINP(2) ;A IF(IHORZ(I,J,RL))GO TO 3
MOVE 1,RINP-3(2) ;B C FINDS SEGS UNDER SLICE AND REJECTS VERTICALS.
CAML 0,1 ; FUNCTION IHORZ(Q,J,RL)
EXCH 0,1 ; DIMENSION Q(1)
CAML 0,LEFT ; IHORZ=-1
JRST FLX3 ; A=Q(J)
;; 8/20/79 CAMG 1,LEFT ; B=Q(J-3)
CAMGE 1,LEFT ; B=Q(J-3)
JRST FLX3 ;PREVIOUS X COORD. IF(A.GT.B)CALL EXCH(A,B)
AOJ 11, ; IF(RL.LE.B.AND.RL.GE.A)IHORZ=0
; M=M+1
; H(M)=HGT(J,RL,I)
MOVE 3,RINP+1(2) ; FUNCTION HGT(J,RL,Q)
FSBR 3,RINP-2(2) ; DIMENSION Q(1)
MOVE LEFT ; HGT=Q(J-2)
FSBR RINP-3(2) ;C PREVIOUS Y COORD.
FMPR 3,0 ; A=Q(J-3)
MOVE RINP(2) ;C PREVIOUS X COORD.
FSBR RINP-3(2) ; HGT=((Q(J+1)-HGT)*(RL-A))/(Q(J)-A)+HGT
FDVR 3,0 ;CAN HAVE A DIVIDE BY ZERO HERE!!
FADR 3,RINP-2(2) ;3 CONTINUE
MOVEM 3,ALF(11) ;H(M)
FLX3: ADDI 2,3
CAMGE 2,RINP+2
JRST FL3
JUMPE 11,FL2 ; IF(M.EQ.0)GO TO 2
;C M=0=SPACE BETWEEN OBJECTS -- NO FILLER
MOVEI 2,1 ; J=1
FL5: MOVE ALF(2) ;5 IF(H(J).GE.H(J+1))GO TO 4
CAML ALF+1(2) ;C SORTS HEIGHTS
JRST FL4 ; CALL EXCH(H(J),H(J+1))
EXCH 0,ALF+1(2)
MOVEM ALF(2)
CAIN 2,1 ; IF(J.EQ.1)GO TO 4
JRST FL4
SOJ 2, ; J=J-1
JRST FL5 ; GO TO 5
FL4: AOJ 2, ;4 J=J+1
CAMGE 2,11 ; IF(J.LT.M)GO TO 5
JRST FL5 ;C GO BACK IF MORE SORTING TO BE DONE
MOVEI 14,1 ; NN=1
FL6: MOVE 13,ALF(14) ;CCCCC6 IF(H(NN).EQ.H(NN+1))GO TO 7
MOVE 12,ALF+1(14) ; A=H(NN)
MOVE 13 ; B=H(NN+1)
FSBR 12
CAMG [1.0] ; IF(A-B.GT.1)CALL LINX(RL,A-1.,RL,B+1.)
JRST FL7
;; 8/20/79 FSBR 13,[1.0] ;LEAVE A LITTLE SPACE (??)
;; 8/20/79 FADR 12,[1.0] ;A IS 13, B IS 12
JSA 16,LINED
JUMP LEFT
JUMP 13
JUMP [3]
JSA 16,LINED
JUMP LEFT
JUMP 12
JUMP [2]
FL7: ADDI 14,2 ;7 NN=NN+2
CAMGE 14,11 ;C SKIP BY 2'S
JRST FL6 ; IF(NN.LT.M)GO TO 6
JRST FL2 ; GO TO 2
FM6: MOVE DX ;2 CALL FILLER(NX,M)
MOVEM PLTR+2 ; DIS=DX
MOVE RX ; RHT=RX
MOVEM PLTR+1
DIST4: JRA 16,6(16) ;5 RETURN
MOVE B ;C NEXT TO RESET DISTORTION FACT.
MOVEM DST ; BB=B
MOVE C ; CC=C
MOVEM DST+1
JRA 16,6(16) ; RETURN
KK←2 ↔ L←3 ↔ LE←4 ↔ T←5 ↔ J←1
RL←6 ↔ RJ←7 ↔ Z←0 ↔ X←11 ↔ JK←10
HG←12 ↔ Y←13 ↔ AL←14 ↔ JJ←15
;;INCR: 2 ;FILLS EVERY OTHER SLICE LINE ON PLOTTER.
; SUBROUTINE FILLER(Q,M)
;;;FILLER: 0
;; HRRZ J,(16)
;; HRRZM J,SVQ#
;; HRRZ T,@1(16)
;; HRRZM T,SVM# ; KK=NE(1)
;**********************THERE IS A BUG WHEN VECTORS CHANGE (JUL 79)*****
CALCMP: HRRZI J,RINP
HRRZM J,SVQ#
MOVEM 16,SV16#
HRRZ KK,2(J)
ADDI KK,-1(J)
; DO 4 K=2,KK
HRRZI L,2(J)
; IF(NE(K).NE.3)GO TO 11
L4: ADDI L,3
HRRZ T,(L)
L11: SETZM (L)
CAIN T,3
; NE(K)=-1
SETOM (L)
; GO TO 4
; 11 NE(K)=0
; 4 CONTINUE
CAIGE L,(KK)
JRST L4
MOVE RL,(J) ; CCC RLFT=10000 RL=Q(1)
MOVE RJ,RL ; CCC RT=-10000 RT=RL
MOVE Z,RJ ; Z=RT
HRRZI L,-3(J) ; DO 12 K=1,KK
L12: ADDI L,3 ; X=IFIX(Q(K))
KIFIX X,(L)
FLTR X,X ;KL10 FLOAT
; IF(X.LT.RLFT)RLFT=X
CAMGE X,RL
MOVE RL,X
; IF(X.GT.RT)RT=X
CAMLE X,RJ
MOVE RJ,X
; IF(X.EQ.Z)NE(K)=-1
CAMN X,Z
SETOM 2(L)
; Z=X
MOVE Z,X
; Q(K)=X
MOVEM X,(L)
; 12 R(K)=IFIX(R(K))
KIFIX T,1(L)
FLTR T,T
MOVEM T,1(L)
CAIGE L,-2(KK)
JRST L12
; NE(KK+1)=-1
SETOM 3(KK)
; LRT=RT
KIFIX RJ,RJ
MOVEM RJ,LRT#
; JA=3
HRRZI T,3
HRRZM T,JA#
; 124 LEFT=RLFT
L124: KIFIX LE,RL
; 51 J=LEFT
L51: MOVE J,LE
; 42 RJ=J+.001
;;L42: MOVE RJ,J
L42: FLTR RJ,J ;FLOAT J, PUT IT IN RJ
FADR RJ,[=0.001]
; JCONT=0
SETZM JCONT#
; LEFT=J
MOVE LE,J
; JJ=-1
SETO JJ,
; ALT=-10000.
MOVN AL,[=10000.0]
; 200 DO 45 L=2,KK
HRRZ L,SVQ
L45: ADDI L,3
CAILE L,-2(KK)
JRST L455
; IF(NE(L).NE.0)GO TO 45
SKIPE 2(L)
JRST L45
; IF(MISS(L,RJ,Q))GO TO 45
CAML RJ,-3(L)
JRST L201
CAMLE RJ,(L)
JRST L202
L201: CAMGE RJ,(L)
CAMG RJ,-3(L)
JRST L45
; X=HGHT(L,RJ,Q,R)
L202: MOVE X,-2(L)
CAMN X,1(L)
JRST RET
MOVNS X
FADR X,1(L)
MOVE Y,-3(L)
MOVNS T,Y
FADR T,RJ
FADR Y,(L)
FMPR X,T
FDVR X,Y
FADR X,-2(L)
; IF(X.LT.ALT)GO TO 45
RET: CAMGE X,AL
JRST L45
; ALT=X
MOVE AL,X
; JJ=L
HRRZI JJ,(L)
; 45 CONTINUE
JRST L45
; IF(JJ)GO TO 43
L455: JUMPL JJ,L43
; JCONT=-1
SETOM JCONT
; LEFT=J
MOVE LE,J
; 46 JA=3
L46: HRRZI T,3
HRRZM T,JA
; JORD=-1
SETOM JORD#
; 52 KN=Q(JJ)
L52: KIFIX T,(JJ)
MOVEM T,KN#
; KL=Q(JJ-1)
KIFIX T,-3(JJ)
MOVEM T,KL#
; IF(KN.LT.KL)KN=KL
CAMLE T,KN
MOVEM T,KN
; 50 I=J
L50: MOVEM J,I#
; 102 RJ=I+.01
;;L102: MOVE RJ,I
L102: FLTR RJ,I ;FLOAT I, PUT IT IN RJ
FADR RJ,[=0.1] ;6/11/75 ←←**↑↑ WAS 0.01 -- CHECK TIGHT CASES!!
; ALT=HGHT(JJ,RJ,Q,R)
MOVE AL,-2(JJ)
CAMN AL,1(JJ)
JRST RET2
MOVNS AL
FADR AL,1(JJ)
MOVE Y,-3(JJ)
MOVNS T,Y
FADR T,RJ
FADR Y,(JJ)
FMPR AL,T
FDVR AL,Y
FADR AL,-2(JJ)
; Z=-10000
RET2: MOVN Z,[=10000.0]
; JK=-1
SETO JK,
; XALT=ALT+.001
MOVE T,AL
FADR T,[=0.001]
MOVEM T,XALT#
; ZALT=ALT
MOVEM AL,ZALT#
; 400 DO 47 L=2,KK
MOVE L,SVQ
L47: ADDI L,3
CAILE L,-2(KK)
JRST L477
; IF(L.EQ.JJ.OR.MISS(L,RJ,Q).OR.NE(L).LT.0)GO TO 47
CAME L,JJ
SKIPGE 2(L)
JRST L47
CAML RJ,-3(L)
JRST L475
CAMLE RJ,(L)
JRST L476
L475: CAMGE RJ,(L)
CAMG RJ,-3(L)
JRST L47
; X=HGHT(L,RJ,Q,R)
L476: MOVE X,-2(L)
CAMN X,1(L)
JRST RET3
MOVNS X
FADR X,1(L)
MOVE Y,-3(L)
MOVNS T,Y
FADR T,RJ
FADR Y,(L)
FMPR X,T
FDVR X,Y
FADR X,-2(L) ; IF(X.GT.XALT)GO TO 47
RET3: CAMG X,XALT ; IF(X.LE.Z)GO TO 47
CAMG X,Z
JRST L47 ; Z=X
MOVE Z,X ; JK=L
HRRZI JK,(L) ; 47 CONTINUE
JRST L47 ; IF(JK)GO TO 48
L477: JUMPL JK,L48 ; 300 IF(ZALT-Z.GT..001.OR.I.NE.J)GO TO 59
MOVN T,Z
FADR T,ZALT
CAMG T,[=0.001]
CAME J,I
JRST L59 ; JX=Q(JK)
KIFIX T,(JK) ; IF(JX.GT.KN)GO TO 60
CAMLE T,KN
JRST L60 ; JX=Q(JK-1)
KIFIX T,-3(JK) ; IF(JX.LT.KN)GO TO 59
CAMGE T,KN
JRST L59 ; 60 L=JJ
L60: MOVE L,JJ ; JJ=JK
MOVE JJ,JK ; JK=L
MOVE JK,L ; KN=JX
MOVEM T,KN ; 59 IF(ALT-Z.LT.2)GO TO 62
L59: MOVN T,Z
FADR T,AL
CAMGE T,[=2.0]
JRST L62
;; HRLZI T,576400 ; ALT=ALT-1
;; FADR AL,T
FADR Z,[1.0] ; Z=Z+1
; 62 IF(JORD)GO TO 103
L62: SKIPGE JORD
JRST L103 ; X=Z
MOVE X,Z ; Z=ALT
MOVE Z,AL ; ALT=X
MOVE AL,X ; IF(JK.NE.NK.AND.ABS(ALT-Z).GT.5.)JA=3
CAMN JK,NK#
JRST L103
MOVN T,Z
FADR T,AL
SKIPGE T
MOVNS T
CAMG T,[5.0]
JRST L103
HRRZI T,3
HRRZM T,JA
; 103 CALL LINES(RJ,ALT,JA)
L103: MOVEM RJ,SVRJ#
MOVEM AL,SVAL#
MOVEM Z,SVB#
HRRZI 16,SVAC
BLT 16,SVAC+15
JSA 16,LINED
JUMP SVRJ
JUMP SVAL
JUMP JA
; 100 CALL LINES(RJ,Z,2)
JSA 16,LINED
JUMP SVRJ
JUMP SVB
JUMP [2]
HRLZI 16,SVAC
BLT 16,15
; NK=JK
MOVEM JK,NK
; JORD=-JORD
MOVNS JORD
; NE(JK)=1
HRRZI T,1
HRRZM T,2(JK)
; NE(JJ)=-1
SETOM 2(JJ)
; JA=2
HRRZI T,2
HRRZM T,JA
; I=I+M
MOVE T,INC ; THIS FORM OF FILLER INCR'S BY 2
ADDB T,I
; IF(I.LT.KN)GO TO 102
CAMGE T,KN
JRST L102
; L=1
HRRZI L,3
; IF(KN.EQ.KL)L=-1
MOVE T,KN
CAMN T,KL
HRROI L,-3
; JJ=JJ+L
ADD JJ,L
; J=0
SETZ J,
; IF(L)J=-1
SKIPGE L
HRROI J,-3
; IF(KN+M.GT.Q(JJ+J).OR.JJ.GT.KK.OR.NE(JJ).NE.0)GO TO 124
SKIPN 2(JJ)
CAILE JJ,-2(KK)
JRST L124
ADD T,INC ; INCR'S BY 2 (FOR PLOTTER)
FLTR T,T
HRRZI HG,(JJ)
ADD HG,J
CAMLE T,(HG)
JRST L124
; J=I
MOVE J,I
; GO TO 52
JRST L52
; 48 JA=3
L48: HRRZI T,3
HRRZM T,JA
; 43 J=LEFT+M
L43: MOVE J,LE
ADD J,INC ;INCR'S BY 2
; IF(J.LE.LRT)GO TO 42
CAMG J,LRT
JRST L42
; IF(JCONT)GO TO 51
SKIPGE JCONT
JRST L51 ; END
MOVE 16,SV16
JRST FM6
SVAC: BLOCK 16
END